home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PASCALL / CLOCKIN / GRAPHIN1.PAS < prev    next >
Pascal/Delphi Source File  |  1993-04-18  |  4KB  |  152 lines
  1. unit graphin1;
  2. interface
  3. uses
  4.      graph,crt;
  5. type
  6.      timing=(hr,min,sec,hndthsec);
  7. const
  8.      gap=1;
  9.      backcolor=black;
  10.      gapcolor=black;
  11.  
  12.      hrhandcolor={5}white;
  13.      minhandcolor={4}white;
  14.      sechandcolor={3}white;
  15.      hndthsechandcolor={2}white;
  16.  
  17.      centerx:integer=241;
  18.      centerc:integer=240;
  19.      centery=239;
  20.  
  21.      hrhandsize=59;
  22.      minhandsize=119;
  23.      sechandsize=179;
  24.      hndthsechandsize=239;
  25.  
  26.      hrhandnumber=24;
  27.      minhandnumber=60;
  28.      sechandnumber=60;
  29.      hndthsechandnumber=100;
  30.  
  31. procedure setupgraph;
  32. procedure setupgrid;
  33.  
  34. function incrementsize(hand:timing):real;
  35. procedure puthand(lasthandposition,handposition:word;  hand:timing);
  36.  
  37. function handcolor(hand:timing):integer;
  38. function handsize(hand:timing):integer;
  39.  
  40. procedure beep;
  41. function streng(num:word):string;
  42.  
  43.  
  44.  
  45. implementation
  46.  
  47. function streng(num:word):string;
  48. var
  49.       strenged:string;
  50. begin
  51.      str(num,strenged);
  52.      if length(strenged)<2 then streng:=concat('0',strenged) else streng:=strenged;
  53. end;
  54.  
  55. procedure beep;
  56. begin
  57.      sound(200);
  58.      delay(1);
  59.      nosound;
  60. end;
  61.  
  62.  
  63. function handcolor(hand:timing):integer;
  64. begin
  65.      case hand of
  66.           hr: handcolor:=hrhandcolor;
  67.           min: handcolor:=minhandcolor;
  68.           sec: handcolor:=sechandcolor;
  69.           hndthsec: handcolor:=hndthsechandcolor;
  70.      end;
  71. end;
  72.  
  73. function handsize(hand:timing):integer;
  74. begin
  75.      case hand of
  76.           hr: handsize:=hrhandsize;
  77.           min: handsize:=minhandsize;
  78.           sec: handsize:=sechandsize;
  79.           hndthsec: handsize:=hndthsechandsize;
  80.      end;
  81. end;
  82.  
  83. function incrementsize(hand:timing):real;
  84. begin
  85.      case hand of
  86.           hr: incrementsize:=360/hrhandnumber;
  87.           min: incrementsize:=360/minhandnumber;
  88.           sec: incrementsize:=360/minhandnumber;
  89.           hndthsec: incrementsize:=360/hndthsechandnumber;
  90.      end;
  91. end;
  92.  
  93. procedure puthand(lasthandposition,handposition:word;  hand:timing);
  94. var
  95.      angl:integer;
  96. begin
  97.      setcolor(handcolor(hand));
  98.      angl:=round(450-(incrementsize(hand)/2)-(incrementsize(hand)*handposition));
  99.      arc(centerx,centery,angl+gap,round(angl-gap+incrementsize(hand)),handsize(hand));
  100.  
  101.      setcolor(backcolor);
  102.      angl:=round(450-(incrementsize(hand)/2)-(incrementsize(hand)*(lasthandposition)));
  103.      arc(centerc,centery,word(angl+gap),word(round(angl-gap+incrementsize(hand))),word(handsize(hand)));
  104. end;
  105.  
  106.  
  107. procedure setupgraph;
  108. var
  109.      Gd, Gm: Integer;
  110. begin
  111.      Gd:=VGA;
  112.      Gm:=vgaHI;
  113.      InitGraph(Gd,Gm,'c:\tp\bgi');
  114.      if GraphResult<>grOk then halt;
  115.      cleardevice;
  116. end;
  117.  
  118. function handnumber(hand:timing):integer;
  119. begin
  120.      case hand of
  121.           hr: handnumber:=hrhandnumber;
  122.           min: handnumber:=minhandnumber;
  123.           sec: handnumber:=sechandnumber;
  124.           hndthsec: handnumber:=hndthsechandnumber;
  125.      end;
  126. end;
  127.  
  128. procedure setupgrid;
  129. const
  130.      solidtype:fillpatterntype=($AA,$AA,$AA,$AA,$AA,$AA,$AA,$AA);
  131. var
  132.      hand:timing;
  133.      handposition,angl:integer;
  134. {     oldpattern:fillpatterntype;}
  135. begin
  136. {     getfillpattern(oldpattern);}
  137.      setfillstyle(solidfill,backcolor);
  138.      setfillpattern(solidtype,backcolor);
  139.      bar(0,0,getmaxx,getmaxy);
  140. {     setcolor(backcolor);
  141.      for hand:=hr to hndthsec do
  142.      begin
  143.           for handposition:=1 to handnumber(hand) do
  144.           begin
  145.                angl:=round(450-(incrementsize(hand)/2)-(incrementsize(hand)*handposition));
  146.                arc(centerx,centery,angl+gap,round(angl-gap+incrementsize(hand)),handsize(hand));
  147.           end;
  148.      end;}
  149. end;
  150.  
  151. begin
  152. end.